Segmentación de clientes según su transaccionalidad

Oportunidad

Actualmente el sistema financiero cuenta con una penetración de tarjetas de crédito del 57,3% en la población bancarizada de Colombia, según estudio realizado por la compañía Minsait por medio de su informe Tendencias en Medios de Pago 2018. Lo cual lleva a la industria a tener grandes retos a nivel de facturación y mejoramiento del servicio, fomentando el uso del dinero plástico. De acuerdo a información de la Superintendencia Financiera de Colombia, el país cuenta con alrededor de 15 millones de plásticos vigentes emitidos, siendo el cuarto país entre 18 países latinoamericanos con mayor número de plásticos.

Tomando una muestra de clientes de una entidad bancaria, se quiere identificar segmentos para desarrollar estrategias particulares dependiendo de las características de cada grupo. Estas estrategias pueden ser de fidelización a largo plazo, adquisición de nuevos servicios, aumento de frecuencia del uso de tarjeta de crédito, entre otras.

Objetivo

Desarrollo

Descripción de la base

Se tiene una base de clientes simulada de una entidad bancaria X, la cual consta del historial transaccional desde el segundo semestre del 2017 hasta el primer semestre del 2019.

Esta base cuenta con 4.999 clientes, cuenta con información demográfica y transaccional.

Directorio de trabajo

setwd("D:/Usuarios/danirorm/Seguros Suramericana, S.A/PROYECTO_MAESTRIA_EAFIT - General/3-Data")

Importación de los datos

#librerias
library(readr)
## Warning: package 'readr' was built under R version 3.4.4
library(dplyr)
## Warning: package 'dplyr' was built under R version 3.4.4
## 
## Attaching package: 'dplyr'
## The following objects are masked from 'package:stats':
## 
##     filter, lag
## The following objects are masked from 'package:base':
## 
##     intersect, setdiff, setequal, union
library(plotly)
## Warning: package 'plotly' was built under R version 3.4.4
## Loading required package: ggplot2
## Warning: package 'ggplot2' was built under R version 3.4.4
## 
## Attaching package: 'plotly'
## The following object is masked from 'package:ggplot2':
## 
##     last_plot
## The following object is masked from 'package:stats':
## 
##     filter
## The following object is masked from 'package:graphics':
## 
##     layout
library(PerformanceAnalytics)
## Warning: package 'PerformanceAnalytics' was built under R version 3.4.4
## Loading required package: xts
## Warning: package 'xts' was built under R version 3.4.4
## Loading required package: zoo
## Warning: package 'zoo' was built under R version 3.4.4
## 
## Attaching package: 'zoo'
## The following objects are masked from 'package:base':
## 
##     as.Date, as.Date.numeric
## 
## Attaching package: 'xts'
## The following objects are masked from 'package:dplyr':
## 
##     first, last
## 
## Attaching package: 'PerformanceAnalytics'
## The following object is masked from 'package:graphics':
## 
##     legend
library(cluster)
## Warning: package 'cluster' was built under R version 3.4.4
library(factoextra)
## Warning: package 'factoextra' was built under R version 3.4.4
## Welcome! Related Books: `Practical Guide To Cluster Analysis in R` at https://goo.gl/13EFCZ
library(tidyverse)
## Warning: package 'tidyverse' was built under R version 3.4.4
## -- Attaching packages --------------------------------- tidyverse 1.2.1 --
## v tibble  2.1.1     v purrr   0.3.0
## v tidyr   0.8.3     v stringr 1.4.0
## v tibble  2.1.1     v forcats 0.4.0
## Warning: package 'tibble' was built under R version 3.4.4
## Warning: package 'tidyr' was built under R version 3.4.4
## Warning: package 'purrr' was built under R version 3.4.4
## Warning: package 'stringr' was built under R version 3.4.4
## Warning: package 'forcats' was built under R version 3.4.4
## -- Conflicts ------------------------------------ tidyverse_conflicts() --
## x plotly::filter() masks dplyr::filter(), stats::filter()
## x xts::first()     masks dplyr::first()
## x dplyr::lag()     masks stats::lag()
## x xts::last()      masks dplyr::last()
library(ggpubr)
## Warning: package 'ggpubr' was built under R version 3.4.4
## Loading required package: magrittr
## Warning: package 'magrittr' was built under R version 3.4.4
## 
## Attaching package: 'magrittr'
## The following object is masked from 'package:purrr':
## 
##     set_names
## The following object is masked from 'package:tidyr':
## 
##     extract
#importar data
options("scipen"=100, "digits"=4)
data_full<- read_delim("Base_modelo.csv",
                         ";", escape_double = FALSE, trim_ws = TRUE)
## Parsed with column specification:
## cols(
##   .default = col_double(),
##   Sexo = col_character(),
##   Grupo_valor = col_character(),
##   Rango_ingresos_acum = col_number(),
##   Nivel_estudio = col_character(),
##   Estado_civil = col_character(),
##   Departamento = col_character(),
##   Hijos = col_character(),
##   Franquicia = col_character(),
##   canal = col_character(),
##   origen = col_character(),
##   Monto_transado = col_number()
## )
## See spec(...) for full column specifications.

Estructura de la base

#Estructura de la base

str(data_full)
## Classes 'spec_tbl_df', 'tbl_df', 'tbl' and 'data.frame': 4999 obs. of  41 variables:
##  $ Cliente_Id         : num  8408675 9705704 9661841 7602888 21018130 ...
##  $ Sexo               : chr  "M" "M" "M" "M" ...
##  $ Estrato            : num  5 4 4 6 6 6 6 4 6 5 ...
##  $ Grupo_valor        : chr  "Alto" "Alto" "Alto" "Alto" ...
##  $ Rango_ingresos_acum: num  7500000 25500000 22500000 36000000 30000000 12000000 51000000 46500000 24000000 12000000 ...
##  $ Nivel_estudio      : chr  "Maestria" "Especializacion" "Pregrado" "Maestria" ...
##  $ Estado_civil       : chr  "VIUDO" "VIUDO" "VIUDO" "SOLTERO" ...
##  $ Departamento       : chr  "BOGOTA D.C." "BOGOTA D.C." "BOGOTA D.C." "BOGOTA D.C." ...
##  $ Edad               : num  111 101 94 92 92 92 91 91 91 90 ...
##  $ Hijos              : chr  "0" "?" "?" "0" ...
##  $ Franquicia         : chr  "AMEX" "VISA" "AMEX" "AMEX" ...
##  $ canal              : chr  "I" "P" "I" "I" ...
##  $ origen             : chr  "Nacional" "Nacional" "Nacional" "Nacional" ...
##  $ Monto_transado     : num  5578975 10091850 22784577 15884697 53528566 ...
##  $ Reclamos           : num  2 2 2 2 2 2 2 3 2 2 ...
##  $ cnt_trx_201706     : num  16 3 5 5 15 10 1 10 4 10 ...
##  $ cnt_trx_201707     : num  19 1 9 12 6 7 3 2 41 14 ...
##  $ cnt_trx_201708     : num  16 4 11 11 1 2 2 4 22 11 ...
##  $ cnt_trx_201709     : num  24 3 9 6 1 12 0 3 45 21 ...
##  $ cnt_trx_201710     : num  16 8 3 8 5 3 0 0 25 12 ...
##  $ cnt_trx_201711     : num  22 14 3 4 1 14 0 2 29 6 ...
##  $ cnt_trx_201712     : num  6 4 9 12 2 5 0 0 38 5 ...
##  $ cnt_trx_201801     : num  15 5 2 18 0 3 0 0 2 4 ...
##  $ cnt_trx_201802     : num  0 4 2 2 0 7 0 0 0 8 ...
##  $ cnt_trx_201803     : num  0 0 3 5 0 3 0 6 0 8 ...
##  $ cnt_trx_201804     : num  0 11 2 5 1 5 0 2 4 6 ...
##  $ cnt_trx_201805     : num  0 2 3 2 5 8 0 5 0 19 ...
##  $ cnt_trx_201806     : num  0 3 2 1 6 9 0 11 0 19 ...
##  $ cnt_trx_201807     : num  0 3 17 1 12 9 0 10 0 12 ...
##  $ cnt_trx_201808     : num  0 1 7 1 3 1 0 10 1 0 ...
##  $ cnt_trx_201809     : num  0 2 3 7 0 9 0 8 0 0 ...
##  $ cnt_trx_201810     : num  0 9 4 6 0 8 0 35 20 2 ...
##  $ cnt_trx_201811     : num  0 3 4 1 1 3 0 19 5 0 ...
##  $ cnt_trx_201812     : num  1 0 5 6 1 5 0 4 4 2 ...
##  $ cnt_trx_201901     : num  0 1 4 1 0 2 0 5 0 0 ...
##  $ cnt_trx_201902     : num  0 0 2 2 0 4 0 4 0 1 ...
##  $ cnt_trx_201903     : num  0 2 6 1 0 5 0 7 0 0 ...
##  $ cnt_trx_201904     : num  0 1 2 10 0 5 0 1 0 0 ...
##  $ cnt_trx_201905     : num  0 3 3 0 0 6 0 12 3 0 ...
##  $ cnt_trx_201906     : num  0 1 4 0 1 2 0 2 1 2 ...
##  $ Total_trx          : num  135 88 124 127 61 147 6 162 244 162 ...
##  - attr(*, "spec")=
##   .. cols(
##   ..   Cliente_Id = col_double(),
##   ..   Sexo = col_character(),
##   ..   Estrato = col_double(),
##   ..   Grupo_valor = col_character(),
##   ..   Rango_ingresos_acum = col_number(),
##   ..   Nivel_estudio = col_character(),
##   ..   Estado_civil = col_character(),
##   ..   Departamento = col_character(),
##   ..   Edad = col_double(),
##   ..   Hijos = col_character(),
##   ..   Franquicia = col_character(),
##   ..   canal = col_character(),
##   ..   origen = col_character(),
##   ..   Monto_transado = col_number(),
##   ..   Reclamos = col_double(),
##   ..   cnt_trx_201706 = col_double(),
##   ..   cnt_trx_201707 = col_double(),
##   ..   cnt_trx_201708 = col_double(),
##   ..   cnt_trx_201709 = col_double(),
##   ..   cnt_trx_201710 = col_double(),
##   ..   cnt_trx_201711 = col_double(),
##   ..   cnt_trx_201712 = col_double(),
##   ..   cnt_trx_201801 = col_double(),
##   ..   cnt_trx_201802 = col_double(),
##   ..   cnt_trx_201803 = col_double(),
##   ..   cnt_trx_201804 = col_double(),
##   ..   cnt_trx_201805 = col_double(),
##   ..   cnt_trx_201806 = col_double(),
##   ..   cnt_trx_201807 = col_double(),
##   ..   cnt_trx_201808 = col_double(),
##   ..   cnt_trx_201809 = col_double(),
##   ..   cnt_trx_201810 = col_double(),
##   ..   cnt_trx_201811 = col_double(),
##   ..   cnt_trx_201812 = col_double(),
##   ..   cnt_trx_201901 = col_double(),
##   ..   cnt_trx_201902 = col_double(),
##   ..   cnt_trx_201903 = col_double(),
##   ..   cnt_trx_201904 = col_double(),
##   ..   cnt_trx_201905 = col_double(),
##   ..   cnt_trx_201906 = col_double(),
##   ..   Total_trx = col_double()
##   .. )
dim(data_full)
## [1] 4999   41
#Nombres de las columnas
names(data_full)
##  [1] "Cliente_Id"          "Sexo"                "Estrato"            
##  [4] "Grupo_valor"         "Rango_ingresos_acum" "Nivel_estudio"      
##  [7] "Estado_civil"        "Departamento"        "Edad"               
## [10] "Hijos"               "Franquicia"          "canal"              
## [13] "origen"              "Monto_transado"      "Reclamos"           
## [16] "cnt_trx_201706"      "cnt_trx_201707"      "cnt_trx_201708"     
## [19] "cnt_trx_201709"      "cnt_trx_201710"      "cnt_trx_201711"     
## [22] "cnt_trx_201712"      "cnt_trx_201801"      "cnt_trx_201802"     
## [25] "cnt_trx_201803"      "cnt_trx_201804"      "cnt_trx_201805"     
## [28] "cnt_trx_201806"      "cnt_trx_201807"      "cnt_trx_201808"     
## [31] "cnt_trx_201809"      "cnt_trx_201810"      "cnt_trx_201811"     
## [34] "cnt_trx_201812"      "cnt_trx_201901"      "cnt_trx_201902"     
## [37] "cnt_trx_201903"      "cnt_trx_201904"      "cnt_trx_201905"     
## [40] "cnt_trx_201906"      "Total_trx"

Limpieza de la base de datos

Se evidencia una fuerta presencia de registros faltantes identificados como “-1” o ?. Según el conocimiento del experto estos datos se clasifican como NA’S.

Se crearán funciones con el objetivo de identificar estos datos y analizarlos.

Función para determinar el porcentaje de datos faltantes en el dataset

# Función usada para determinar el porcentaje de datos faltantes en un set de datos
missingData <- function(data) {
  
  print("Porcentaje NA's en cada Columna")
  
  # Porcentaje de NA's en cada Columna
  porcNA <- round(sapply(data, function(y) sum(is.na(y)))/nrow(data)*100, 2)
  print(porcNA[porcNA > 0])
  
  print("Porcentaje de Registros con valor de -1 en cada columna")
  
  # Porcentaje de Variables sin Información en Cada Columna
  porcSinInf <- round(sapply(data, function(y) sum(as.character(y) == '-1', na.rm = T))/nrow(data)*100, 2)
  print(porcSinInf[porcSinInf > 0])
  
  print("Porcentaje de Registros con valor de ? en cada columna")
  
  # Porcentaje de Variables sin Información en Cada Columna
  porcSinInf <- round(sapply(data, function(y) sum(as.character(y) == '?', na.rm = T))/nrow(data)*100, 2)
  print(porcSinInf[porcSinInf > 0])
  
}

Data Cleaning

Para empezar la limpieza de los datos, se debe conocer como estan los datos con un summary de la base.

#Resumen de la base
summary(data_full)
##    Cliente_Id           Sexo              Estrato     Grupo_valor       
##  Min.   :   23206   Length:4999        Min.   :1.00   Length:4999       
##  1st Qu.:12254482   Class :character   1st Qu.:4.00   Class :character  
##  Median :25172803   Mode  :character   Median :5.00   Mode  :character  
##  Mean   :24886674                      Mean   :4.95                     
##  3rd Qu.:37386930                      3rd Qu.:6.00                     
##  Max.   :49430008                      Max.   :6.00                     
##  Rango_ingresos_acum      Nivel_estudio      Estado_civil      
##  Min.   :        450000   Length:4999        Length:4999       
##  1st Qu.:       6900000   Class :character   Class :character  
##  Median :      13500000   Mode  :character   Mode  :character  
##  Mean   :   17178331396                                        
##  3rd Qu.:      22500000                                        
##  Max.   :21681818181000                                        
##  Departamento            Edad          Hijos            Franquicia       
##  Length:4999        Min.   : 25.0   Length:4999        Length:4999       
##  Class :character   1st Qu.: 34.0   Class :character   Class :character  
##  Mode  :character   Median : 44.0   Mode  :character   Mode  :character  
##                     Mean   : 45.5                                        
##                     3rd Qu.: 56.0                                        
##                     Max.   :111.0                                        
##     canal              origen          Monto_transado        Reclamos    
##  Length:4999        Length:4999        Min.   :       0   Min.   : 2.00  
##  Class :character   Class :character   1st Qu.: 3630950   1st Qu.: 2.00  
##  Mode  :character   Mode  :character   Median : 9081903   Median : 2.00  
##                                        Mean   :15111380   Mean   : 2.51  
##                                        3rd Qu.:19445268   3rd Qu.: 3.00  
##                                        Max.   :98744657   Max.   :14.00  
##  cnt_trx_201706   cnt_trx_201707   cnt_trx_201708   cnt_trx_201709  
##  Min.   :  0.00   Min.   :  0.00   Min.   :  0.00   Min.   :  0.00  
##  1st Qu.:  2.00   1st Qu.:  2.00   1st Qu.:  2.00   1st Qu.:  1.00  
##  Median :  4.00   Median :  5.00   Median :  5.00   Median :  4.00  
##  Mean   :  6.66   Mean   :  9.48   Mean   :  8.84   Mean   :  8.51  
##  3rd Qu.:  8.00   3rd Qu.: 12.00   3rd Qu.: 11.00   3rd Qu.: 11.00  
##  Max.   :101.00   Max.   :143.00   Max.   :182.00   Max.   :202.00  
##  cnt_trx_201710   cnt_trx_201711  cnt_trx_201712   cnt_trx_201801  
##  Min.   :  0.00   Min.   :  0.0   Min.   :  0.00   Min.   :  0.00  
##  1st Qu.:  1.00   1st Qu.:  1.0   1st Qu.:  1.00   1st Qu.:  0.00  
##  Median :  4.00   Median :  4.0   Median :  4.00   Median :  3.00  
##  Mean   :  8.48   Mean   :  8.4   Mean   :  8.17   Mean   :  7.43  
##  3rd Qu.: 10.00   3rd Qu.: 11.0   3rd Qu.: 10.00   3rd Qu.:  9.00  
##  Max.   :220.00   Max.   :216.0   Max.   :173.00   Max.   :253.00  
##  cnt_trx_201802 cnt_trx_201803  cnt_trx_201804  cnt_trx_201805 
##  Min.   :  0    Min.   :  0.0   Min.   :  0.0   Min.   :  0.0  
##  1st Qu.:  0    1st Qu.:  0.0   1st Qu.:  0.0   1st Qu.:  0.0  
##  Median :  2    Median :  3.0   Median :  3.0   Median :  2.0  
##  Mean   :  7    Mean   :  7.5   Mean   :  7.3   Mean   :  7.3  
##  3rd Qu.:  8    3rd Qu.:  9.0   3rd Qu.:  9.0   3rd Qu.:  9.0  
##  Max.   :404    Max.   :427.0   Max.   :515.0   Max.   :430.0  
##  cnt_trx_201806 cnt_trx_201807   cnt_trx_201808   cnt_trx_201809  
##  Min.   :  0    Min.   :  0.00   Min.   :  0.00   Min.   :  0.00  
##  1st Qu.:  0    1st Qu.:  0.00   1st Qu.:  0.00   1st Qu.:  0.00  
##  Median :  2    Median :  2.00   Median :  2.00   Median :  1.00  
##  Mean   :  7    Mean   :  6.69   Mean   :  6.41   Mean   :  5.86  
##  3rd Qu.:  8    3rd Qu.:  8.00   3rd Qu.:  7.00   3rd Qu.:  7.00  
##  Max.   :210    Max.   :192.00   Max.   :201.00   Max.   :164.00  
##  cnt_trx_201810   cnt_trx_201811   cnt_trx_201812   cnt_trx_201901  
##  Min.   :  0.00   Min.   :  0.00   Min.   :  0.00   Min.   :  0.00  
##  1st Qu.:  0.00   1st Qu.:  0.00   1st Qu.:  0.00   1st Qu.:  0.00  
##  Median :  1.00   Median :  1.00   Median :  1.00   Median :  0.00  
##  Mean   :  6.44   Mean   :  5.78   Mean   :  5.52   Mean   :  4.81  
##  3rd Qu.:  7.00   3rd Qu.:  6.00   3rd Qu.:  6.00   3rd Qu.:  5.00  
##  Max.   :221.00   Max.   :207.00   Max.   :124.00   Max.   :111.00  
##  cnt_trx_201902   cnt_trx_201903   cnt_trx_201904  cnt_trx_201905  
##  Min.   :  0.00   Min.   :  0.00   Min.   :  0.0   Min.   :  0.00  
##  1st Qu.:  0.00   1st Qu.:  0.00   1st Qu.:  0.0   1st Qu.:  0.00  
##  Median :  0.00   Median :  0.00   Median :  0.0   Median :  0.00  
##  Mean   :  4.73   Mean   :  4.53   Mean   :  4.6   Mean   :  4.83  
##  3rd Qu.:  5.00   3rd Qu.:  4.00   3rd Qu.:  4.0   3rd Qu.:  4.00  
##  Max.   :135.00   Max.   :120.00   Max.   :158.0   Max.   :185.00  
##  cnt_trx_201906     Total_trx   
##  Min.   :  0.00   Min.   :   0  
##  1st Qu.:  0.00   1st Qu.:  40  
##  Median :  0.00   Median :  92  
##  Mean   :  4.32   Mean   : 167  
##  3rd Qu.:  4.00   3rd Qu.: 200  
##  Max.   :142.00   Max.   :3293

Al ver el resumen de la base , se evidencia observaciones que se salen del pormedio y que son minoría de la muestra obtenida por lo tanto se contextualiza con el conocimiento del experto y se filtra por rango de ingresos y así tendremos mas exactitud en los resultados de la población estudiada.

Se filtra por rango de ingresos acumulados año entre 450 mil y 90 millones, luego el nuevo data set queda como data1

#Rango de ingresos acumulados al año entre 450 mil y 90 millones

data1<-data_full %>% filter(Rango_ingresos_acum %in% (450000:90000000))

Identificación de caracteres especiales

Función para encontrar el porcentaje de missing data

missingData(data1)
## [1] "Porcentaje NA's en cada Columna"
## named numeric(0)
## [1] "Porcentaje de Registros con valor de -1 en cada columna"
## named numeric(0)
## [1] "Porcentaje de Registros con valor de ? en cada columna"
## Hijos 
## 77.07

En la columna Hijos se identifica caracteres como ?

head(data1$Hijos)
## [1] "0" "?" "?" "0" "?" "1"

Se evidencia que el 77,07% de los registros tienen el caracter especial de “?” , como no se pueden eliminar sin ser tratados se pueden guardar en una base para luego analizarlos y mejorar los datos pero por ahora no se trabajaran con estos registros NA’S.

Datos con “?”

datosconsigno<-data1 %>% filter(Hijos=="?")
dim(datosconsigno)
## [1] 3848   41

Nuevo dataset = data1

data1<-data1 %>% filter(Hijos!="?")

El monto transado debe ser mayor que cero, data2 nuevo dataset

data2<-data1 %>% filter(Monto_transado != 0 )

Análisis de la distribución de la edad

Edad

# Ahora vamos a analizar como se  distribuye la poblacion
plot_ly(data2, x = ~Edad, type = "histogram")%>% config(displayModeBar = F)

La población de estudio esta entre 25 y 60 años

#la poblacion estudio esta entre 25 y 60 años
data3<-data2 %>% filter(Edad %in% (25:60))
#histograma
plot_ly(data3, x = ~Edad, type = "histogram")%>% config(displayModeBar = F)
#boxplot
plot_ly(data3, y = ~Edad, type = "box")

Nuevo dataset = data3

Análisis de las variables categóricas

Distribución por género

#Distribucion por genero
table(data3$Sexo)
## 
##   F   M 
## 407 463
sort(prop.table(table(data3$Sexo))*100, decreasing = T)
## 
##     M     F 
## 53.22 46.78

Se evidencia en la poblacion que el 53.22% son Hombres y el 46.7% son Mujeres.

Nivel de estudio

#Distribución por Nivel estudio
table(data3$Nivel_estudio)
## 
##       Bachiller Especializacion        Maestria        Pregrado 
##               5             495             192             156 
##         tecnico       Tecnologo 
##              17               5
sort(prop.table(table(data3$Nivel_estudio))*100, decreasing = T)
## 
## Especializacion        Maestria        Pregrado         tecnico 
##         56.8966         22.0690         17.9310          1.9540 
##       Bachiller       Tecnologo 
##          0.5747          0.5747
plot_ly(data3, x = ~Nivel_estudio, type = "histogram")%>% config(displayModeBar = F)

Se evidencia una participación del 56,8% de personas que tienen nivel de estudios con especialización.

Estado civil

#Estado civil
table(data3$Estado_civil)
## 
##      CASADO  DIVORCIADO     SOLTERO UNION LIBRE       VIUDO 
##         486          11         327          43           3
sort(prop.table(table(data3$Estado_civil))*100, decreasing = T)
## 
##      CASADO     SOLTERO UNION LIBRE  DIVORCIADO       VIUDO 
##     55.8621     37.5862      4.9425      1.2644      0.3448

Participación por Departamento

#Departamento
table(data3$Departamento)
## 
##        ANTIOQUIA      BOGOTA D.C.           CALDAS     CUNDINAMARCA 
##              333              420                1                3 
## SANTIAGO DE CALI  VALLE DEL CAUCA 
##                3              110
sort(prop.table(table(data3$Departamento))*100, decreasing = T)
## 
##      BOGOTA D.C.        ANTIOQUIA  VALLE DEL CAUCA     CUNDINAMARCA 
##          48.2759          38.2759          12.6437           0.3448 
## SANTIAGO DE CALI           CALDAS 
##           0.3448           0.1149

Se evidencia mayor participación en los departamentos de Bogotá D.C y Antioquia respectivamente.

Partipacipación por franquicias

#Franquicias
table(data3$Franquicia)
## 
##   AMEX MASTER   VISA 
##    247    122    501
sort(prop.table(table(data3$Franquicia))*100, decreasing = T)
## 
##   VISA   AMEX MASTER 
##  57.59  28.39  14.02
plot_ly(data3, x = ~Franquicia, type = "histogram")%>% config(displayModeBar = F)

Con una participación del 57,5% Visa es la franquicia que registra mas transacciones acumuladas en los usuarios entre el 2017 y el 2019.

Canal

#Canal
table(data3$canal)
## 
##       I Ninguno       P 
##     393       1     476
sort(prop.table(table(data3$canal))*100, decreasing = T)
## 
##       P       I Ninguno 
## 54.7126 45.1724  0.1149

Se evidencia mayor participación en pagos presenciales (54,7%) en comparación por pagos en internet (45,1%).

Distribución por canal según el nivel de estudio

Medio de pago Presente

data_p<-data3 %>% filter(canal=="P")
data_I<-data3 %>% filter(canal=="I")

plot_ly(data_p, x = ~Nivel_estudio,  y= ~canal, type = "histogram")%>% config(displayModeBar = F)

Medio de pago Internet

plot_ly(data_I, x = ~Nivel_estudio,  y= ~canal, type = "histogram")%>% config(displayModeBar = F)

Las personas que tienen además de un pregrado otros estudios, tienden a usar mas el internet como medio de pago con el uso de las tarjetas de crédito.

Origen

#Origen
table(data3$origen)
## 
## Internacional      Nacional       Ninguno 
##           236           633             1
sort(prop.table(table(data3$origen))*100, decreasing = T)
## 
##      Nacional Internacional       Ninguno 
##       72.7586       27.1264        0.1149

Distribución por estrato

table(data3$Estrato)
## 
##   2   3   4   5   6 
##   1   1 312 274 282
sort(prop.table(table(data3$Estrato))*100, decreasing = T)
## 
##       4       6       5       2       3 
## 35.8621 32.4138 31.4943  0.1149  0.1149
plot_ly(data3, x = ~Estrato, type = "histogram")%>% config(displayModeBar = F)

La gran población esta entre estrato 4 y 6

Reclamos acumulados

table(data3$Reclamos)
## 
##   2   3   6 
## 438 430   2
sort(prop.table(table(data3$Reclamos))*100, decreasing = T)
## 
##       2       3       6 
## 50.3448 49.4253  0.2299
plot_ly(data3, x = ~Reclamos, type = "histogram")%>% config(displayModeBar = F)

Distribución por hijos

#hijos
plot_ly(data3, y = ~Hijos, type = "box", name = "Num Hijos")
plot_ly(data3, x = ~Hijos, type = "histogram")%>% config(displayModeBar = F)

Distribución por total de transacciones acumuladas

#Distribucion del total de trx acum
plot_ly(data3, x = ~Total_trx, type = "histogram")%>% config(displayModeBar = F)

Correlaciones entre las variables numéricas

Para mirar la relación entre las variables numéricas, se realizará un análisis con la matriz de correlaciones.

Este análisis aporta el conocimiento de las relaciones directas o indirectas con el aumento de la frecuencia de transacciones de las personas.

Correlación todas las variables

cor(select(data3, "Edad", "Rango_ingresos_acum", "Monto_transado", "Total_trx"))
##                         Edad Rango_ingresos_acum Monto_transado Total_trx
## Edad                1.000000             0.01772       0.002128  0.027350
## Rango_ingresos_acum 0.017722             1.00000       0.308474 -0.017302
## Monto_transado      0.002128             0.30847       1.000000 -0.005797
## Total_trx           0.027350            -0.01730      -0.005797  1.000000

Cuando se realiza el análisis de correlaciones entre todas las variables se evidencia una fuerte correlación positiva entre monto transado y Rango de ingresos, lo cual tiene coherencia entre más ingresos tiene la persona gastará mas.

Adicionalmente se observa que la edad no tiene fuerte correlación con ninguna de las variables, podemos decir que la edad no es un factor significativo a la hora de saber si la persona tiene mas capacidad adquisitiva y por lo tanto sus transacciones aumentarán. Matriz gráfica

chart.Correlation(select(data3, "Edad", "Rango_ingresos_acum", "Monto_transado", "Total_trx"),histogram = TRUE, pch=19)

Correlaciones dejando fija la variable Total_trx

Total_trx vs Edad

cor(select(data3, "Total_trx","Edad"))
##           Total_trx    Edad
## Total_trx   1.00000 0.02735
## Edad        0.02735 1.00000
chart.Correlation(select(data3, "Edad", "Total_trx"),histogram = TRUE, pch=19)

Total_trx vs Rango_ingresos_acum

cor(select(data3, "Total_trx","Rango_ingresos_acum"))
##                     Total_trx Rango_ingresos_acum
## Total_trx              1.0000             -0.0173
## Rango_ingresos_acum   -0.0173              1.0000
chart.Correlation(select(data3,  "Rango_ingresos_acum","Total_trx"),histogram = TRUE, pch=19)

Total_trx vs Monto_transado

cor(select(data3, "Total_trx","Monto_transado"))
##                Total_trx Monto_transado
## Total_trx       1.000000      -0.005797
## Monto_transado -0.005797       1.000000
chart.Correlation(select(data3, "Monto_transado","Total_trx"),histogram = TRUE, pch=19)

Por lo anterior, se puede evidenciar que ni la edad, el rango de ingresos o el monto transado son variables que estan directamente relacionadas con las transacciones acumuladas.

Modelamiento

Segmentación mediante el uso de K-MEANS

Hoy en día para cualquier empresa, segmentar es una manera de dividir un problema en partes más sencillas que ayuda a priorizar esfuerzos y a localizar oportunidades de negocio.

Se puede evidenciar que no todos los clientes son iguales ni tienen las mismas capacidades adquisitivas por lo tanto, es importante entender e identificar valor de grupos de individuos.

Definición Segmentar es dividir una población en grupos homogéneos en función de necesidades, comportamientos, características o actitudes y caracterizar a los grupos resultantes para saber qué les distingue entre sí.

Aplicación para el caso de estudio

Con la metodología K-Means se desea responder algunas preguntas de negocio que son importantes para la creación de estrategias para el aumento de valor de la compañia.

Con K-Means se quiere responder los siguientes cuestionamientos.

Desarrollo

Para realizar el modelo los clientes deben tener como mínimio una transacción acumulada y luego se seleccionan las variables numéricas del dataset para la clusterización.

Se segmento de acuerdo a: - Edad - Rango Ingresos - Monto transado - Total trx acumuladas

# transacciones mayores que cero
data3<-data3 %>% filter(Total_trx>0) 

#Selección del k optimo = 3: edad, rango_ingresos, monto, total trx
fviz_nbclust(data3[,c(5,9,14,41)], kmeans, method = "gap_stat")

Modelo con k=3

#modelo kmeans
ModeloKMEANS <- kmeans(data3[,c(5,9,14,41)],3)
ModeloKMEANS
## K-means clustering with 3 clusters of sizes 260, 521, 88
## 
## Cluster means:
##   Rango_ingresos_acum  Edad Monto_transado Total_trx
## 1            30684231 44.29       16459302     179.3
## 2             9120058 43.60        8063690     163.9
## 3            22377273 44.74       61446961     146.4
## 
## Clustering vector:
##   [1] 1 1 1 1 1 1 1 1 1 3 2 2 2 2 2 2 2 2 2 2 2 2 2 2 3 3 1 3 1 1 2 1 3 2 3
##  [36] 2 3 2 2 2 3 2 2 2 2 2 2 3 2 2 2 2 2 3 1 3 1 1 3 1 1 1 1 2 2 2 2 2 2 2
##  [71] 2 2 2 2 2 2 2 3 1 1 1 1 2 3 2 2 1 2 2 2 2 2 2 2 2 1 3 1 1 1 1 1 1 2 2
## [106] 3 2 2 2 2 2 2 3 2 2 2 2 2 2 2 2 1 1 1 1 1 3 1 3 1 1 1 3 2 2 3 2 2 2 2
## [141] 2 2 2 2 2 1 1 1 1 1 1 1 1 2 2 2 2 2 2 2 2 2 2 2 2 3 1 1 1 1 1 1 1 1 2
## [176] 1 1 1 2 1 1 3 2 2 2 2 2 2 2 2 3 1 1 1 1 3 1 1 2 2 2 2 2 2 2 2 2 2 2 2
## [211] 2 2 2 2 2 2 2 2 2 1 1 1 1 1 1 2 1 3 1 1 1 3 2 2 2 2 2 2 2 2 2 2 2 3 2
## [246] 2 2 2 2 2 3 1 1 3 1 1 1 1 1 1 1 1 3 1 1 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2
## [281] 2 2 2 2 2 1 1 1 1 1 1 1 1 2 1 1 3 2 2 2 2 2 2 2 3 2 2 2 2 2 2 3 2 2 2
## [316] 2 1 1 1 1 1 1 1 1 1 3 2 2 2 2 2 2 2 2 2 2 1 1 1 1 1 2 2 3 2 3 2 2 2 2
## [351] 2 2 2 2 2 2 2 2 2 2 2 1 1 1 1 1 1 1 3 1 2 2 2 2 2 2 2 2 3 2 2 2 2 2 2
## [386] 2 2 1 1 1 1 1 1 1 1 2 3 1 1 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 3 2 2 2 2 2
## [421] 2 2 2 2 1 3 1 1 1 1 1 1 1 2 2 3 3 2 3 2 2 2 2 3 2 2 2 2 2 2 2 2 2 1 1
## [456] 1 3 1 1 1 2 1 3 1 2 2 2 2 2 2 2 2 2 3 2 2 2 2 2 1 1 1 1 1 1 3 1 1 1 1
## [491] 1 3 1 1 3 2 2 2 1 2 2 1 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 1 1 1 1 3 3 1 1
## [526] 3 3 2 1 2 2 2 3 3 2 2 2 2 2 2 2 3 2 2 2 2 2 3 2 2 2 1 1 1 1 3 2 2 2 2
## [561] 2 2 2 2 2 2 2 2 2 2 2 2 2 1 1 1 1 1 1 3 1 1 1 1 2 2 1 1 1 3 3 2 2 2 2
## [596] 2 2 2 2 2 2 2 1 1 1 3 3 1 1 1 1 1 1 2 2 2 2 2 2 2 2 2 2 2 2 2 2 1 1 1
## [631] 1 1 2 3 2 2 2 2 2 2 2 2 2 2 2 2 2 2 1 1 3 1 1 1 2 2 2 2 2 2 2 2 2 2 2
## [666] 2 2 2 2 2 2 1 1 1 1 3 1 1 3 3 1 2 3 2 2 2 3 2 2 2 2 2 2 2 2 2 2 2 1 1
## [701] 3 1 3 1 1 1 1 2 3 2 2 2 3 2 2 2 2 2 2 2 2 2 2 2 1 1 1 1 1 3 2 2 2 2 2
## [736] 2 2 2 2 2 2 1 1 3 3 1 1 1 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 1 1 1 1 1 2
## [771] 2 2 2 3 2 2 2 3 2 2 2 1 1 1 1 2 2 3 2 2 2 2 2 2 2 2 2 1 1 2 2 2 2 3 2
## [806] 2 2 2 2 2 2 2 2 2 2 1 1 3 1 1 1 2 1 2 3 2 2 2 2 2 2 2 1 1 1 1 1 1 1 1
## [841] 1 1 2 2 2 2 2 2 2 2 2 2 2 2 1 1 2 1 2 2 2 2 3 2 2 2 2 3 2
## 
## Within cluster sum of squares by cluster:
## [1] 50621271974271128 40616746895220960 41627009661003544
##  (between_SS / total_SS =  69.2 %)
## 
## Available components:
## 
## [1] "cluster"      "centers"      "totss"        "withinss"    
## [5] "tot.withinss" "betweenss"    "size"         "iter"        
## [9] "ifault"

Gráfica del modelo

km.res <- kmeans(data3[,c(5,9,14,41)], 3)

fviz_cluster(km.res, data = data3[,c(5,9,14,41)], frame.type = "convex")
## Warning: argument frame is deprecated; please use ellipse instead.
## Warning: argument frame.type is deprecated; please use ellipse.type
## instead.

Distribución de clusters

cluster<-km.res$cluster
cluster
##   [1] 3 3 3 3 3 3 3 3 3 1 2 2 2 2 2 2 2 2 2 2 2 2 2 2 1 1 3 1 3 3 2 3 1 2 1
##  [36] 2 1 2 2 2 1 2 2 2 2 2 2 1 2 2 2 2 2 1 3 1 3 3 1 3 3 3 3 2 2 2 2 2 2 2
##  [71] 2 2 2 2 2 2 2 1 3 3 3 3 2 1 2 2 3 2 2 2 2 2 2 2 2 3 1 3 3 3 3 3 3 2 2
## [106] 1 2 2 2 2 2 2 1 2 2 2 2 2 2 2 2 3 3 3 3 3 1 3 1 3 3 3 1 2 2 1 2 2 2 2
## [141] 2 2 2 2 2 3 3 3 3 3 3 3 3 2 2 2 2 2 2 2 2 2 2 2 2 1 3 3 3 3 3 3 3 3 2
## [176] 3 3 3 2 3 3 1 2 2 2 2 2 2 2 2 1 3 3 3 3 1 3 3 2 2 2 2 2 2 2 2 2 2 2 2
## [211] 2 2 2 2 2 2 2 2 2 3 3 3 3 3 3 2 3 1 3 3 3 1 2 2 2 2 2 2 2 2 2 2 2 1 2
## [246] 2 2 2 2 2 1 3 3 1 3 3 3 3 3 3 3 3 1 3 3 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2
## [281] 2 2 2 2 2 3 3 3 3 3 3 3 3 2 3 3 1 2 2 2 2 2 2 2 1 2 2 2 2 2 2 1 2 2 2
## [316] 2 3 3 3 3 3 3 3 3 3 1 2 2 2 2 2 2 2 2 2 2 3 3 3 3 3 2 2 1 2 1 2 2 2 2
## [351] 2 2 2 2 2 2 2 2 2 2 2 3 3 3 3 3 3 3 1 3 2 2 2 2 2 2 2 2 1 2 2 2 2 2 2
## [386] 2 2 3 3 3 3 3 3 3 3 2 1 3 3 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 1 2 2 2 2 2
## [421] 2 2 2 2 3 1 3 3 3 3 3 3 3 2 2 1 1 2 1 2 2 2 2 1 2 2 2 2 2 2 2 2 2 3 3
## [456] 3 1 3 3 3 2 3 1 3 2 2 2 2 2 2 2 2 2 1 2 2 2 2 2 3 3 3 3 3 3 1 3 3 3 3
## [491] 3 1 3 3 1 2 2 2 3 2 2 3 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 3 3 3 3 1 1 3 3
## [526] 1 1 2 3 2 2 2 1 1 2 2 2 2 2 2 2 1 2 2 2 2 2 1 2 2 2 3 3 3 3 1 2 2 2 2
## [561] 2 2 2 2 2 2 2 2 2 2 2 2 2 3 3 3 3 3 3 1 3 3 3 3 2 2 3 3 3 1 1 2 2 2 2
## [596] 2 2 2 2 2 2 2 3 3 3 1 1 3 3 3 3 3 3 2 2 2 2 2 2 2 2 2 2 2 2 2 2 3 3 3
## [631] 3 3 2 1 2 2 2 2 2 2 2 2 2 2 2 2 2 2 3 3 1 3 3 3 2 2 2 2 2 2 2 2 2 2 2
## [666] 2 2 2 2 2 2 3 3 3 3 1 3 3 1 1 3 2 1 2 2 2 1 2 2 2 2 2 2 2 2 2 2 2 3 3
## [701] 1 3 1 3 3 3 3 2 1 2 2 2 1 2 2 2 2 2 2 2 2 2 2 2 3 3 3 3 3 1 2 2 2 2 2
## [736] 2 2 2 2 2 2 3 3 1 1 3 3 3 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 3 3 3 3 3 2
## [771] 2 2 2 1 2 2 2 1 2 2 2 3 3 3 3 2 2 1 2 2 2 2 2 2 2 2 2 3 3 2 2 2 2 1 2
## [806] 2 2 2 2 2 2 2 2 2 2 3 3 1 3 3 3 2 3 2 1 2 2 2 2 2 2 2 3 3 3 3 3 3 3 3
## [841] 3 3 2 2 2 2 2 2 2 2 2 2 2 2 3 3 2 3 2 2 2 2 1 2 2 2 2 1 2

Creación de la columna Cluster para el dataset y distribución por grupo

data3$Grupo_cluster <- ModeloKMEANS$cluster

table(data3$Grupo_cluster)
## 
##   1   2   3 
## 260 521  88
sort(prop.table(table(data3$Grupo_cluster))*100, decreasing = T)
## 
##     2     1     3 
## 59.95 29.92 10.13

Se realizó una segmentación con un k óptimo = 3, donde el grupo 2 tiene mayor participación del 59,9%, mientras que el grupo 1 tiene el 29,9% y el el grupo 3 con una participación del 10,13% según la cantidad de la población seleccionada.

Estadísticas por cada cluster

G1<-data3 %>% select(Edad, Rango_ingresos_acum, Monto_transado, Total_trx,Grupo_cluster) %>% filter(Grupo_cluster==1)
summary(G1)
##       Edad      Rango_ingresos_acum Monto_transado       Total_trx   
##  Min.   :26.0   Min.   :15000000    Min.   :   65418   Min.   :   4  
##  1st Qu.:38.0   1st Qu.:24000000    1st Qu.: 8897368   1st Qu.:  46  
##  Median :45.0   Median :27150000    Median :14513316   Median :  91  
##  Mean   :44.3   Mean   :30684231    Mean   :16459302   Mean   : 179  
##  3rd Qu.:52.0   3rd Qu.:36000000    3rd Qu.:23046245   3rd Qu.: 201  
##  Max.   :60.0   Max.   :69000000    Max.   :41314956   Max.   :3078  
##  Grupo_cluster
##  Min.   :1    
##  1st Qu.:1    
##  Median :1    
##  Mean   :1    
##  3rd Qu.:1    
##  Max.   :1
G2<-data3 %>% select(Edad, Rango_ingresos_acum, Monto_transado, Total_trx,Grupo_cluster) %>% filter(Grupo_cluster==2)
summary(G2)
##       Edad      Rango_ingresos_acum Monto_transado       Total_trx   
##  Min.   :25.0   Min.   :  600000    Min.   :   21553   Min.   :   3  
##  1st Qu.:36.0   1st Qu.: 4500000    1st Qu.: 2953731   1st Qu.:  41  
##  Median :44.0   Median : 7500000    Median : 5562137   Median :  80  
##  Mean   :43.6   Mean   : 9120058    Mean   : 8063690   Mean   : 164  
##  3rd Qu.:51.0   3rd Qu.:12000000    3rd Qu.:11647922   3rd Qu.: 222  
##  Max.   :60.0   Max.   :24000000    Max.   :36880460   Max.   :2094  
##  Grupo_cluster
##  Min.   :2    
##  1st Qu.:2    
##  Median :2    
##  Mean   :2    
##  3rd Qu.:2    
##  Max.   :2
G3<-data3 %>% select(Edad, Rango_ingresos_acum, Monto_transado, Total_trx,Grupo_cluster) %>% filter(Grupo_cluster==3)
summary(G3)
##       Edad      Rango_ingresos_acum Monto_transado       Total_trx   
##  Min.   :25.0   Min.   : 4500000    Min.   :37455947   Min.   :   7  
##  1st Qu.:37.8   1st Qu.:13125000    1st Qu.:46770714   1st Qu.:  37  
##  Median :44.0   Median :20550000    Median :58545560   Median :  87  
##  Mean   :44.7   Mean   :22377273    Mean   :61446961   Mean   : 146  
##  3rd Qu.:53.0   3rd Qu.:27375000    3rd Qu.:72983372   3rd Qu.: 163  
##  Max.   :60.0   Max.   :90000000    Max.   :98580554   Max.   :1238  
##  Grupo_cluster
##  Min.   :3    
##  1st Qu.:3    
##  Median :3    
##  Mean   :3    
##  3rd Qu.:3    
##  Max.   :3

Se observa que el cluster 1, cuenta con clientes que han tenido un máximo de transacciones de 3078 y con montro máximo transado de mas de 400 millones, se podría decir que las personas que están en este grupo son mas propensas a transar mas y sus gastos son mayores, por lo tanto este sería el grupo potencial para fortalecer lazos comerciales y adquision de nuevos productos.

Con el cluster 2 y 3, tiene caracteristicas similares , pero adicional a esto, existen clientes que son más propensos a gastar menos por lo tanto el monto transado es menor. Estos clientes se tendrían que mirar con mayor detenimiendo si se quiere que ellos aumenten el número de transacciones y que no se fugen, se debe crear estrategias de fidelación y negociación de tarifas.